home *** CD-ROM | disk | FTP | other *** search
/ Alles Voor Internet / Tout Pour Internet / alles voor internet.iso / MacInternet™ / Modem / QuickDial_1.3 Folder / quickdial.p 1⁄21⁄94 (1.3) < prev    next >
Text File  |  1994-01-22  |  6KB  |  239 lines
  1. program quickDial;
  2.  
  3. { QuickDial takes text and dumps AT^m ATD<text>,;H to the modem. This dials the number & hangs up after 2 second. }
  4. { The program first gets text from STR id 128. This is the dialing prefix prepended to all numbers. }
  5. { Then it tries to read STR id 129. If that is blank, it tries to read the clipboard for the number. }
  6. { This way, you can have a general quickdial for all your numbers and special ones to call specific }
  7. { frequently-used (your mother, for example). }
  8. { The program will beep if there is no text in STR 129 or the clipboard. }
  9. { The program is basically meant to go under the System 7 Apple menu. }
  10. {  Unlike the few programs I looked at, I am nice & properly close the serial port when done! }
  11. { I found the source code of the Busy or Not DA by Kiron Bondale, 1988, quite useful. }
  12. { Feel free to send email to mblain@aol.com with comments/suggestions/etc... }
  13. {  Matthew Blain, 7/30/93. Public Domain. This source code can be freely distributed. }
  14. { Version 1.0.1 of 8/1/93 should close the serial port. V 1.0 didn't really. }
  15. { VErsion 1.0.2 of 8/6 does atdT (tone dial) and also sends a prelimiary AT^m }
  16. { Version 1.1 of 8/26/93 reads STR's id 128 and 129. If it is blank, it reads the clipboard. }
  17. { Version 1.2 of 8/27/93 waits for a response from the modem before quitting . I assume Q0. }
  18. { Version 1.3 of 1/21/94 doesn't wait for a response. Rather, it reads STR id 130, and waits }
  19. {                         that many seconds before quitting. }
  20. {    Version 1.3 also no longer assumes the ATDT commands; you must store ATD in str 128 if you want that. }
  21. {    It still appends ;H0, however. }
  22.  
  23.  
  24.     uses
  25.         Serial, Scrap;
  26.  
  27.     var
  28.         InRefNum, OutRefNum, i: integer;
  29.         waiter: longint;
  30.         Err: OSErr;
  31.         numb, s: str255;
  32.  
  33.     procedure init;
  34.     begin
  35. { This is the ultimate in facelessness... }
  36. { Don't even bother initializing everything }
  37. {    InitGraf(@ThePort); InitFonts; InitWindows; InitMenus; TEInit; InitDialogs(nil);}
  38. {    FlushEvents(EveryEvent, 0);}
  39.     end;
  40.  
  41.     procedure openserial;
  42.         var
  43.             config: integer;
  44.     begin
  45.         config := baud1200 + data8 + stop10 + NoParity;
  46. { Baud1200 should work with any modem! }
  47.         Err := OpenDriver('.AIn', inRefNum);
  48.         Err := OpenDriver('.AOut', OutRefNum);
  49.         Err := SerReset(InRefNum, config);
  50.         Err := SerReset(OutRefNum, config);
  51.     end;
  52.  
  53.     procedure closeserial;
  54.     begin
  55. {    Err := FSClose(OutRefNum);}
  56. {    Err := FSClose(InRefNum);}
  57.         err := closeDriver(InRefNum);
  58.         err := closeDriver(OutRefNum);
  59.         OutRefNum := 0;
  60.         InRefNum := 0;
  61.     end;
  62.  
  63.     procedure getstr (id: integer; var s: str255);
  64.         var
  65.             tHndl: StringHandle;
  66.     begin
  67.         s := '';
  68.         tHndl := GetString(id);
  69.         s := concat(' ', tHndl^^, ' ');
  70.     end;
  71.  
  72.     procedure getnumber (var numb: str255);
  73.         var
  74.             thndl: Handle;
  75.             l, offset: longInt;
  76.     begin
  77.         numb := '';
  78.         getstr(129, numb);
  79.         if (length(numb) = 2) then { 2 = blank. Why, I know not?!!! }
  80.             begin
  81.                 tHndl := NewHandle(0);
  82.                 l := GetScrap(tHndl, 'TEXT', offset);
  83.                 if (offset > 0) then { it returned something useful. }
  84.                     begin
  85.                         GetIText(tHndl, numb); { cheat conversion }
  86.                     end;
  87.             end;
  88.     end;
  89.  
  90.     procedure sendstring (s: string);
  91.         var
  92.             i: integer;
  93.             c: char;
  94.             count: LongInt;
  95.             buffer: packed array[1..10] of char;
  96.     begin
  97.         count := 1;
  98.         for i := 1 to length(s) do
  99.             begin
  100.                 buffer[1] := (s[i]);
  101.                 Err := FSWrite(OutRefNum, count, @buffer);
  102.             end;
  103.     end;
  104.  
  105.     procedure getstring (s: str255);
  106.         var
  107.             i: integer;
  108.             c: char;
  109.             count: longInt;
  110.             buffer, temp: ptr;
  111.     begin
  112.         Err := FSRead(inRefNum, count, buffer);
  113.         s := '';
  114.         for i := 0 to (count - 1) do
  115.             begin
  116.                 temp := Ptr(Ord(Buffer) + i);
  117.                 s[i] := Chr(temp^);
  118.             end;
  119.     end;
  120.  
  121.     procedure dialnumber (numb: str255);
  122.         var
  123.             prefix: str255;
  124.             modemstr: str255;
  125.     begin
  126.         prefix := '';
  127.         getstr(128, prefix);
  128.         modemstr := concat(prefix, numb, ',;H0', chr(13));
  129.         sendstring(modemstr);
  130. { Any Hayes-compatible modem should be able to handle the semicolon H0 to hang up. }
  131.     end;
  132.  
  133. { OBSOLETE procedure. 8/26/93 }
  134.     procedure sendhangup;
  135.         var
  136.             ticks: longInt;
  137.     begin
  138.         delay(65, ticks);
  139.         sendstring('+++');
  140.         delay(65, ticks);
  141.         sendstring(concat('ATH0', chr(13)));
  142.     end;
  143.  
  144.     function ator (var s: str255): real;
  145.     { This is really clumsy, but works just well enough for my needs. }
  146.         var
  147.             c: char;
  148.             f: real;
  149.             d, i: integer;
  150.     begin
  151.         d := 2; { before the number }
  152.         f := 0;
  153.         for i := 1 to length(s) do
  154.             begin
  155.                 c := (s[i]);
  156.                 if d = 2 then
  157.                     begin
  158.                         if ((c >= '0') and (c <= '9')) then
  159.                             d := 1; { in the number }
  160.                     end; { if before the number. }
  161.                 if d = 1 then
  162.                     begin
  163.                         if ((c >= '0') and (c <= '9')) then
  164.                             begin
  165.                                 f := (f * 10) + ord(c) - 48;
  166.                             end
  167.                         else if (c = '.') then
  168.                             begin
  169.                                 d := -10;
  170.                             end
  171.                         else
  172.                             begin
  173.                                 d := 0;
  174.                             end; { what to do when left of decimal }
  175.                     end { if left of decimal }
  176.                 else if d < 0 then
  177.                     begin
  178.                         if ((c >= '0') and (c <= '9')) then
  179.                             begin
  180.                                 f := f + ((ord(c) - 48) / (-d));
  181.                                 d := d * 10;
  182.                             end
  183.                         else
  184.                             begin
  185.                                 d := 0;
  186.                             end; { what to do when right of decimal }
  187.                     end; { if in number}
  188. { else if d is 0, ignore the rest. }
  189.             end; { loop }
  190.         ator := f;
  191.     end;
  192.  
  193. { This will wait for as many seconds as are present in str id 130 }
  194.     procedure waitasrequested;
  195.         var
  196.             ticks: longint;
  197.             s: str255;
  198.             f: real;
  199.             i, requested: longint;
  200.     begin
  201.         getstr(130, s);
  202.         f := ator(s); { make it a float/real }
  203.         requested := trunc(f * 12);
  204.  
  205.         for i := 1 to requested do
  206.             begin
  207.                 delay(5, ticks);
  208.                 systemtask;
  209. { be somewhat nice, if only 12 times per second. }
  210.             end;
  211.     end;
  212.  
  213.  
  214. { Main }
  215. begin
  216.     Init;
  217.     getnumber(numb);
  218.     if (length(numb) > 0) then
  219.         begin
  220.             openserial;
  221.             systemtask;
  222.             sendstring(concat('AT', chr(13)));
  223. { Wake up modem }
  224.             systemtask;
  225.             delay(60, waiter); { wait 1 seconds }
  226.             systemtask;
  227.             dialnumber(numb);
  228.  
  229. { Attempt to wait for a response. }
  230. {getstring(s);writeln('first response is');writeln(s);getstring(s);writeln('second response is');writeln(s);}
  231. {writeln('hit return');readln;}
  232.  
  233.             waitasrequested;
  234.             systemtask;
  235.             closeserial;
  236.         end
  237.     else
  238.         sysbeep(10); { No number found! }
  239. end.